perm filename MOTIV.F4[SCR,LCS] blob
sn#365862 filedate 1978-07-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00004 ENDMK
C⊗;
C≡≡≡≡≡≡ THIS IS THE REQUIRED HEADER FOR 'SCORE' SUBROUTINES. ≡≡≡≡≡≡≡
SUBROUTINE SUBR
COMMON /P/P(1) /PL/PL(1) /INS/ INST(27),BG(60)
COMMON INUM,IPAR,CNT(27),BT,IREST,DF,DUR(27)
C INUM=INST# IPAR=PARAM#
C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C IF IREST IS <0, THAT NOTE WILL BE A REST.
C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
C F1=86 F15=100 (NO F16!)
DIMENSION A(3), B(3), C(3), KK(27), M(27)
DATA A/0,2.,1./, B/0,4.,10./, C/0,-2.,-1./, KA/4/,KB/4/,KC/4/
C 1ST MOTIVE GOES UP 1 STEP, DOWN 1/2 STEP. 'C' IS INVERSION OF 'A'.
K=KK(INUM)
IF(K.NE.0)GO TO 10
M(INUM)=P(3)
J=RAND(1.0,3.99)
C PICK A MOTIVE. 1, 2 OR 3.
10 K=K+1
GO TO (1,2,3)J
1 P(3)=A(K)+M(INUM)
IF(K.EQ.KA)K=0
4 KK(INUM)=K
C SAVE VALUE OF K FOR NEXT TIME AROUND.
IF(K.EQ.0)IREST=-1
C LAST 'NOTE' OF EACH MOTIVE WILL BE A REST.
RETURN
2 P(3)=B(K)+M(INUM)
IF(K.EQ.KB)K=0
GO TO 4
3 P(3)=C(K)+M(INUM)
IF(K.EQ.KC)K=0
GO TO 4
END